home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / NRCOBOL1g / COBFILES / ERRANT.COB < prev    next >
Encoding:
Text File  |  1999-03-23  |  10.4 KB  |  302 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID. ERRANT.
  3.        AUTHOR. MALCOLM FLEET.
  4.        ENVIRONMENT DIVISION.
  5.        INPUT-OUTPUT SECTION.
  6.        FILE-CONTROL.
  7.            SELECT SORTED-VALID-FILE ASSIGN TO 'A:ZENSD.DAT'
  8.                 ORGANIZATION LINE SEQUENTIAL.
  9.            SELECT CUST-MAST-FILE ASSIGN TO  'A:CUSTMAST.MF'
  10.                 ORGANIZATION LINE SEQUENTIAL.
  11.            SELECT STOCK-MAST-FILE ASSIGN TO 'A:STCKMAST.DAT'
  12.                 ORGANIZATION INDEXED
  13.                 ACCESS MODE RANDOM
  14.                 RECORD KEY ST-PART-NUMBER.
  15.            SELECT NEW-CUST-MAST-FILE ASSIGN TO 'A:ZENNF.DAT'
  16.                 ORGANIZATION LINE SEQUENTIAL.
  17.            SELECT ERROR-FILE ASSIGN TO PRINTER.
  18.       *
  19.       *******************************************
  20.       *
  21.  
  22.        DATA DIVISION.
  23.        FILE SECTION.
  24.        FD  SORTED-VALID-FILE.
  25.        01  S-I-REC.
  26.            03 S-REC-TYPE        PIC X.
  27.            03 S-CUST-CODE       PIC X(5).
  28.               88 END-OF-S-VALID-FILE VALUE HIGH-VALUES.
  29.            03 S-PART-NUMBER     PIC X(6).
  30.            03 S-ISS-RECEIPT-QUANT PIC 9(4).
  31.  
  32.        01  S-DELETION-REC.
  33.            03                    PIC X(6).
  34.  
  35.        01  S-CREATION-REC.
  36.            03                    PIC X(6).
  37.            03 S-CUSTOMER-NAME    PIC X(20).
  38.            03 S-CUSTOMER-ADDRESS PIC X(60).
  39.            03 S-CUSTOMER-BALANCE PIC S9(7)V99.
  40.            03 S-CREDIT-LIMIT     PIC X(7).
  41.  
  42.        FD CUST-MAST-FILE.
  43.        01 CUST-MAST-REC.
  44.            03 MAST-CUST-CODE     PIC X(5).
  45.               88 END-OF-C-MAST-FILE VALUE HIGH-VALUES.
  46.            03 MAST-CUST-NAME     PIC X(20).
  47.            03 MAST-CUST-ADDRESS  PIC X(60).
  48.            03 MAST-CUST-BALANCE  PIC S9(7)V99.
  49.            03 MAST-CREDIT-LIMIT  PIC X(7).
  50.            03 MAST-LAST-MOVE-DATE.
  51.               05 M-L-DAY         PIC 9(2).
  52.               05 M-L-MONTH       PIC 9(2).
  53.               05 M-L-YEAR        PIC 9(2).
  54.  
  55.        FD STOCK-MAST-FILE.
  56.        01 STOCK-MAST-REC.
  57.            03 ST-PART-NUMBER     PIC X(6).
  58.            03 ST-PART-DESC       PIC X(19).
  59.            03 ST-SUPP-CODE       PIC 9(2).
  60.            03 ST-FREE-STOCK      PIC 9(6).
  61.            03 ST-MIN-STOCK-LEV   PIC 9(4).
  62.            03 ST-LAST-MOVE-DATE  PIC 9(6).
  63.            03 ST-SELLING-PRICE   PIC 9(4)V99.
  64.  
  65.        FD NEW-CUST-MAST-FILE.
  66.        01 NEW-CUST-REC.
  67.           03 N-MAST-CUST-CODE    PIC X(5).
  68.           03 N-MAST-CUST-NAME    PIC X(20).
  69.           03 N-MAST-CUST-ADDRESS PIC X(60).
  70.           03 N-MAST-CUST-BALANCE PIC S9(7)V99.
  71.           03 N-M-L-MOVE-DAY      PIC 99.
  72.           03 N-M-L-MOVE-MONTH    PIC 99.
  73.           03 N-M-L-MOVE-YEAR     PIC 99.
  74.  
  75.        FD ERROR-FILE
  76.            LINAGE IS 60 LINES
  77.            WITH FOOTING AT 56
  78.            LINES AT TOP 2
  79.            LINES AT BOTTOM 4.
  80.        01 ERROR-REC            PIC X(130).
  81.       *
  82.       *******************************************
  83.       *
  84.        WORKING-STORAGE SECTION.
  85.        78 original value 1.                 *> flag code change
  86.  
  87.        01 W-LINE-COUNT     PIC 99 VALUE ZERO.
  88.        01 W-PAGE-COUNT     PIC 99 VALUE 0.
  89.        01 W-REC-COUNT      PIC 9(4) VALUE ZERO.
  90.        01 STOCK-VALUE      PIC 9(7)V99.
  91.        01 W-DOS-DATE.
  92.           03 W-DOS-YEAR    PIC 99.
  93.           03 W-DOS-MONTH   PIC 99.
  94.           03 W-DOS-DAY     PIC 99.
  95.        01 W-IN-DATE.
  96.           03 W-IN-YEAR     PIC 99.
  97.           03 W-IN-MONTH    PIC 99.
  98.           03 W-IN-DAY      PIC 99.
  99.  
  100.        01 W-HEADING-1.
  101.           03               PIC X(77) VALUE
  102.             "                                   **** ZENITH PAINTS -ERR0
  103.       -"R REPORT ****".
  104.           03 W-HDG-DAY     PIC 99.
  105.           03               PIC X VALUE "/".
  106.           03 W-HDG-MONTH   PIC 99.
  107.           03               PIC X VALUE "/".
  108.           03 W-HDG-YEAR    PIC 99.
  109.           03               PIC X(8) VALUE
  110.             "  PAGE: ".
  111.           03 PRINT-PAGE-COUNT   PIC Z(4)9.
  112.  
  113.        01 W-HEADING-2.
  114.           03               PIC X(80) VALUE
  115.             "                                TRANSACTIONS NOT UPDATED TO
  116.       -" CUSTOMER MASTER FILE".
  117.  
  118.        01 W-HEADING-3.
  119.           03               PIC X(70) VALUE
  120.             "  RECORD     CUSTOMER     CUSTOMER                 PART
  121.       -"  ERROR    ".
  122.  
  123.        01 W-HEADING-4.
  124.           03               PIC X(70) VALUE
  125.             "  TYPE       CODE         NAME                     NUMBER
  126.       -"  MESSAGE  ".
  127.  
  128.        01 DETAIL-LINE.
  129.           03                 PIC X(4) VALUE SPACES.
  130.           03 PRINT-REC-TYPE  PIC X.
  131.           03                 PIC X VALUE SPACES.
  132.           03 PRINT-CUST-CODE PIC 9(5).
  133.           03                 PIC X(8) VALUE SPACES.
  134.           03 PRINT-CUST-NAME PIC X(20).
  135.           03                 PIC X(5) VALUE SPACES.
  136.           03 PRINT-PART-NUM  PIC X(6).
  137.           03                 PIC X(4) VALUE SPACES.
  138.           03 ERROR-MESSAGE   PIC X(45).
  139.  
  140.        01 TOTAL-LINE.
  141.           03                 PIC X(66) VALUE
  142.             "                                TOTAL NUMBER OF INVALID REC
  143.       -"ORDS = ".
  144.           03 PRINT-TOTAL-RECORD-COUNT PIC Z(5)9.
  145.       *
  146.       *******************************************
  147.       *
  148.  
  149.        PROCEDURE DIVISION.
  150.        MAIN-CONTROL.
  151.            PERFORM INITIAL-PROCESS
  152.            PERFORM UPDATE-PROCESS UNTIL END-OF-S-VALID-FILE AND
  153.                                         END-OF-C-MAST-FILE
  154.            PERFORM FINAL-PROCESS
  155.            STOP RUN.
  156.  
  157.        INITIAL-PROCESS.
  158.            OPEN INPUT  SORTED-VALID-FILE
  159.                        CUST-MAST-FILE
  160.                        STOCK-MAST-FILE
  161.                 OUTPUT NEW-CUST-MAST-FILE
  162.                        ERROR-FILE
  163.             ACCEPT W-DOS-DATE FROM DATE
  164.             MOVE W-DOS-YEAR TO W-HDG-YEAR
  165.             MOVE W-DOS-MONTH TO W-HDG-MONTH
  166.             MOVE W-DOS-DAY TO W-HDG-DAY
  167.             PERFORM NEW-HEADINGS
  168.             PERFORM READ-SORTED-VALID-FILE
  169.             PERFORM READ-CUST-MAST-FILE.
  170.  
  171.        UPDATE-PROCESS.
  172.             EVALUATE TRUE
  173.                 WHEN S-CUST-CODE > MAST-CUST-CODE
  174.                      PERFORM UPDATE-MASTER
  175.                 WHEN S-CUST-CODE < MAST-CUST-CODE
  176.                      PERFORM PROCESS-NEW-CUST
  177.                 WHEN S-CUST-CODE = MAST-CUST-CODE
  178.                      PERFORM UPDATE-TRANS-TO-MAST
  179.             END-EVALUATE.
  180.  
  181.        NEW-HEADINGS.
  182.             MOVE 0 TO W-LINE-COUNT
  183.             ADD 1 TO W-PAGE-COUNT
  184.             MOVE W-PAGE-COUNT TO PRINT-PAGE-COUNT
  185.             WRITE ERROR-REC FROM W-HEADING-1 AFTER PAGE
  186.             WRITE ERROR-REC FROM W-HEADING-2 AFTER 2
  187.             WRITE ERROR-REC FROM W-HEADING-3 AFTER 2
  188.             WRITE ERROR-REC FROM W-HEADING-4 AFTER 1.
  189.  
  190.        READ-SORTED-VALID-FILE.
  191.             READ SORTED-VALID-FILE AT END
  192.                    MOVE HIGH-VALUES TO S-CUST-CODE
  193.             END-READ.
  194.  
  195.        READ-CUST-MAST-FILE.
  196.             READ CUST-MAST-FILE AT END
  197.                    MOVE HIGH-VALUES TO MAST-CUST-CODE
  198.             END-READ.
  199.  
  200.        UPDATE-MASTER.
  201.             WRITE NEW-CUST-REC FROM CUST-MAST-REC
  202.                   PERFORM READ-CUST-MAST-FILE.
  203.  
  204.        PROCESS-NEW-CUST.
  205.             IF S-REC-TYPE = 'C' THEN
  206.                MOVE S-CUST-CODE TO N-MAST-CUST-CODE
  207.                MOVE S-CUSTOMER-NAME TO N-MAST-CUST-NAME
  208.                MOVE S-CUSTOMER-ADDRESS TO N-MAST-CUST-ADDRESS
  209.                MOVE S-CUSTOMER-BALANCE TO N-MAST-CUST-BALANCE
  210.                MOVE W-DOS-YEAR TO N-M-L-MOVE-YEAR
  211.                MOVE W-DOS-MONTH TO N-M-L-MOVE-MONTH
  212.                MOVE W-DOS-DAY TO N-M-L-MOVE-DAY
  213.                WRITE NEW-CUST-REC
  214.                PERFORM READ-SORTED-VALID-FILE
  215.             ELSE
  216.                MOVE 'INVALID RECORD TYPE- SHOULD BE TYPE C'
  217.                      TO ERROR-MESSAGE
  218.                PERFORM READ-SORTED-VALID-FILE
  219.             END-IF.
  220.  
  221.        UPDATE-TRANS-TO-MAST.
  222.  
  223.       $if original defined
  224.             EVALUATE TRUE
  225.                WHEN S-REC-TYPE = 'I' OR 'R' PERFORM ISSUE-REC-UPDATE
  226.                WHEN S-REC-TYPE = 'C' PERFORM CREATION-UPDATE
  227.                WHEN S-REC-TYPE = 'D' PERFORM DELETE-RECORD
  228.             END-EVALUATE.
  229.       $else
  230.             EVALUATE S-REC-TYPE
  231.                WHEN 'I' PERFORM ISSUE-REC-UPDATE
  232.                WHEN 'R' PERFORM ISSUE-REC-UPDATE
  233.                WHEN 'C' PERFORM CREATION-UPDATE
  234.                WHEN 'D' PERFORM DELETE-RECORD
  235.                WHEN OTHER PERFORM PRINT-INVALID-TRANSACTION
  236.             END-EVALUATE.
  237.       $end
  238.  
  239.        ISSUE-REC-UPDATE.
  240.             MOVE S-PART-NUMBER TO ST-PART-NUMBER
  241.             READ STOCK-MAST-FILE
  242.               INVALID KEY
  243.                   MOVE 'PART NUMBER NOT FOUND- INVALID PART NUMBER'
  244.                         TO ERROR-MESSAGE
  245.                   PERFORM PRINT-ERROR
  246.                   PERFORM READ-SORTED-VALID-FILE
  247.               NOT INVALID KEY
  248.                   MULTIPLY ST-SELLING-PRICE BY S-ISS-RECEIPT-QUANT
  249.                         GIVING STOCK-VALUE
  250.                   END-MULTIPLY
  251.                           IF S-REC-TYPE = 'I' THEN
  252.                     ADD STOCK-VALUE TO MAST-CUST-BALANCE
  253.                 ELSE
  254.                      SUBTRACT STOCK-VALUE FROM MAST-CUST-BALANCE
  255.                 END-IF
  256.                 MOVE W-DOS-YEAR TO M-L-YEAR
  257.                 MOVE W-DOS-MONTH TO M-L-MONTH
  258.                 MOVE W-DOS-DAY TO M-L-DAY
  259.                 WRITE NEW-CUST-REC FROM CUST-MAST-REC
  260.                 PERFORM READ-SORTED-VALID-FILE.
  261.  
  262.        CREATION-UPDATE.
  263.             MOVE 'INVALID RECORD TYPE- CANNOT BE C TYPE'
  264.                   TO ERROR-MESSAGE
  265.             PERFORM PRINT-ERROR
  266.             PERFORM READ-SORTED-VALID-FILE.
  267.  
  268.        DELETE-RECORD.
  269.             IF MAST-CUST-BALANCE NOT = 0 THEN
  270.                 MOVE 'CUSTOMER BALANCE NOT ZERO- DO NOT DELETE'
  271.                       TO ERROR-MESSAGE
  272.                 PERFORM PRINT-ERROR
  273.                 PERFORM READ-SORTED-VALID-FILE
  274.             ELSE
  275.                 PERFORM READ-SORTED-VALID-FILE
  276.                 PERFORM READ-CUST-MAST-FILE
  277.             END-IF.
  278.  
  279.        PRINT-ERROR.
  280.             MOVE S-REC-TYPE TO PRINT-REC-TYPE
  281.             MOVE S-CUST-CODE TO PRINT-CUST-CODE
  282.             MOVE S-PART-NUMBER TO PRINT-PART-NUM
  283.             WRITE ERROR-REC FROM DETAIL-LINE AFTER 1
  284.             MOVE SPACES TO ERROR-MESSAGE
  285.             ADD 1 TO W-LINE-COUNT
  286.               IF W-LINE-COUNT > 49 THEN
  287.                  PERFORM NEW-HEADINGS
  288.               ELSE
  289.                   ADD 1 TO W-REC-COUNT
  290.                   MOVE W-REC-COUNT TO PRINT-TOTAL-RECORD-COUNT
  291.                   WRITE ERROR-REC FROM TOTAL-LINE AFTER 2
  292.               END-IF.
  293.  
  294.        FINAL-PROCESS.
  295.             CLOSE SORTED-VALID-FILE
  296.             CLOSE CUST-MAST-FILE
  297.             CLOSE STOCK-MAST-FILE
  298.             CLOSE NEW-CUST-MAST-FILE
  299.             CLOSE ERROR-FILE
  300.             STOP RUN.
  301.  
  302.